home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / source / ProjectOberon / Oberon.mod < prev    next >
Text File  |  1995-07-02  |  13KB  |  469 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: Oberon.mod $
  4.   Description: Partial port of the Project Oberon module
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.11 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/04 23:24:07 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. ***************************************************************************)
  16.  
  17. <* STANDARD- *>
  18.  
  19. MODULE Oberon; (*JG 6.9.90 / 23.9.93 / 15.10.94*)
  20.  
  21.   IMPORT
  22.     Kernel, Modules, Input := InputPO, Display, Fonts, Viewers, Texts, OberonClock;
  23.  
  24.   CONST
  25.  
  26.     (*message ids*)
  27.     consume* = 0; track* = 1;
  28.     defocus* = 0; neutralize* = 1; mark* = 2;
  29.  
  30.     BasicCycle = 20;
  31.  
  32.     ESC = 1BX; SETUP = 0A4X;
  33.  
  34.   TYPE
  35.  
  36.     Painter* = PROCEDURE (x, y: INTEGER);
  37.     Marker* = RECORD Fade*, Draw*: Painter END;
  38.  
  39.     Cursor* = RECORD
  40.         marker*: Marker; on*: BOOLEAN; X*, Y*: INTEGER
  41.     END;
  42.  
  43.     ParList* = POINTER TO ParRec;
  44.  
  45.     ParRec* = RECORD
  46.       vwr*: Viewers.Viewer;
  47.       frame*: Display.Frame;
  48.       text*: Texts.Text;
  49.       pos*: LONGINT
  50.     END;
  51.  
  52.     InputMsg* = RECORD (Display.FrameMsg)
  53.       id*: INTEGER;
  54.       keys*: SET;
  55.       X*, Y*: INTEGER;
  56.       ch*: CHAR;
  57.       fnt*: Fonts.Font;
  58.       col*, voff*: SHORTINT
  59.     END;
  60.  
  61.     SelectionMsg* = RECORD (Display.FrameMsg)
  62.       time*: LONGINT;
  63.       text*: Texts.Text;
  64.       beg*, end*: LONGINT
  65.     END;
  66.  
  67.     ControlMsg* = RECORD (Display.FrameMsg)
  68.       id*, X*, Y*: INTEGER
  69.     END;
  70.  
  71.     CopyOverMsg* = RECORD (Display.FrameMsg)
  72.       text*: Texts.Text;
  73.       beg*, end*: LONGINT
  74.     END;
  75.  
  76.     CopyMsg* = RECORD (Display.FrameMsg)
  77.       F*: Display.Frame
  78.     END;
  79.  
  80.     Task* = POINTER TO TaskDesc;
  81.  
  82.     Handler* = PROCEDURE;
  83.  
  84.     TaskDesc* = RECORD
  85.       next: Task;
  86.       safe*: BOOLEAN;
  87.       time*: LONGINT;
  88.       handle*: Handler
  89.     END;
  90.  
  91.   VAR
  92.     User*: ARRAY 8 OF CHAR;
  93.     Password*: LONGINT;
  94.  
  95.     Arrow*, Star*: Marker;
  96.     Mouse*, Pointer*: Cursor;
  97.  
  98.     FocusViewer*: Viewers.Viewer;
  99.  
  100.     Log*: Texts.Text;
  101.     Par*: ParList; (*actual parameters*)
  102.  
  103.     CurTask*, PrevTask: Task;
  104.  
  105.     CurFnt*: Fonts.Font; CurCol*, CurOff*: SHORTINT;
  106.  
  107.     DW, DH, CL, H0, H1, H2, H3: INTEGER;
  108.     unitW: INTEGER;
  109.  
  110.     ActCnt: INTEGER; (*action count for GC*)
  111.     Mod: Modules.Module;
  112.  
  113.   (*user identification*)
  114.  
  115.   PROCEDURE Code(VAR s: ARRAY OF CHAR): LONGINT;
  116.     VAR i: INTEGER; a, b, c: LONGINT;
  117.   BEGIN
  118.     a := 0; b := 0; i := 0;
  119.     WHILE s[i] # 0X DO
  120.       c := b; b := a; a := (c MOD 509 + 1) * 127 + ORD(s[i]);
  121.       INC(i)
  122.     END;
  123.     IF b >= 32768 THEN b := b - 65536 END;
  124.     RETURN b * 65536 + a
  125.   END Code;
  126.  
  127.   PROCEDURE SetUser* (VAR user, password: ARRAY OF CHAR);
  128.   BEGIN COPY(user, User); Password := Code(password)
  129.   END SetUser;
  130.  
  131.   (*clocks*)
  132.  
  133.   PROCEDURE GetClock* (VAR t, d: LONGINT);
  134.   BEGIN OberonClock.GetClock(t, d)
  135.   END GetClock;
  136.  
  137.   PROCEDURE SetClock* (t, d: LONGINT);
  138.   BEGIN (*OberonClock.SetClock(t, d)*)
  139.   END SetClock;
  140.  
  141.   PROCEDURE Time* (): LONGINT;
  142.   BEGIN RETURN Input.Time()
  143.   END Time;
  144.  
  145.   (*cursor handling*)
  146.  
  147.   PROCEDURE* FlipArrow (X, Y: INTEGER);
  148.   BEGIN
  149.     IF X < CL THEN
  150.       IF X > DW - 15 THEN X := DW - 15 END
  151.     ELSE
  152.       IF X > CL + DW - 15 THEN X := CL + DW - 15 END
  153.     END;
  154.     IF Y < 14 THEN Y := 14 ELSIF Y > DH THEN Y := DH END;
  155.     Display.CopyPattern(Display.white, Display.arrow, X, Y - 14, 2)
  156.   END FlipArrow;
  157.      
  158.   PROCEDURE* FlipStar (X, Y: INTEGER);
  159.   BEGIN
  160.     IF X < CL THEN
  161.       IF X < 7 THEN X := 7 ELSIF X > DW - 8 THEN X := DW - 8 END
  162.     ELSE
  163.       IF X < CL + 7 THEN X := CL + 7 ELSIF X > CL + DW - 8 THEN X := CL + DW
  164. - 8 END
  165.     END ;
  166.     IF Y < 7 THEN Y := 7 ELSIF Y > DH - 8 THEN Y := DH - 8 END;
  167.     Display.CopyPattern(Display.white, Display.star, X - 7, Y - 7, 2)
  168.   END FlipStar;
  169.  
  170.   PROCEDURE OpenCursor* (VAR c: Cursor);
  171.   BEGIN c.on := FALSE; c.X := 0; c.Y := 0
  172.   END OpenCursor;
  173.  
  174.   PROCEDURE FadeCursor* (VAR c: Cursor);
  175.   BEGIN IF c.on THEN c.marker.Fade(c.X, c.Y); c.on := FALSE END
  176.   END FadeCursor;
  177.  
  178.   PROCEDURE DrawCursor* (VAR c: Cursor; VAR m: Marker; X, Y: INTEGER);
  179.   BEGIN
  180.     IF c.on & ((X # c.X) OR (Y # c.Y) OR (m.Draw # c.marker.Draw)) THEN
  181.       c.marker.Fade(c.X, c.Y); c.on := FALSE
  182.     END;
  183.     IF ~c.on THEN
  184.       m.Draw(X, Y); c.marker := m; c.X := X; c.Y := Y; c.on := TRUE
  185.     END
  186.   END DrawCursor;
  187.  
  188.   (*display management*)
  189.  
  190.   PROCEDURE RemoveMarks* (X, Y, W, H: INTEGER);
  191.   BEGIN
  192.     IF (Mouse.X > X - 16) & (Mouse.X < X + W + 16) & (Mouse.Y > Y - 16) & (Mouse.Y
  193. < Y + H + 16) THEN
  194.       FadeCursor(Mouse)
  195.     END;
  196.     IF (Pointer.X > X - 8) & (Pointer.X < X + W + 8) & (Pointer.Y > Y - 8) &
  197. (Pointer.Y < Y + H + 8) THEN
  198.       FadeCursor(Pointer)
  199.     END
  200.   END RemoveMarks;
  201.  
  202.   PROCEDURE* HandleFiller (V: Display.Frame; VAR M: Display.FrameMsg);
  203.   BEGIN
  204.     WITH V: Viewers.Viewer DO
  205.       IF M IS InputMsg THEN
  206.         WITH M: InputMsg DO
  207.           IF M.id = track THEN DrawCursor(Mouse, Arrow, M.X, M.Y) END
  208.         END;
  209.       ELSIF M IS ControlMsg THEN
  210.          WITH M: ControlMsg DO
  211.            IF M.id = mark THEN DrawCursor(Pointer, Star, M.X, M.Y) END
  212.          END
  213.       ELSIF M IS Viewers.ViewerMsg THEN
  214.         WITH M: Viewers.ViewerMsg DO
  215.           IF (M.id = Viewers.restore) & (V.W > 0) & (V.H > 0) THEN
  216.             RemoveMarks(V.X, V.Y, V.W, V.H);
  217.             Display.ReplConst(Display.black, V.X, V.Y, V.W, V.H, 0)
  218.           ELSIF (M.id = Viewers.modify) & (M.Y < V.Y) THEN
  219.             RemoveMarks(V.X, M.Y, V.W, V.Y - M.Y);
  220.             Display.ReplConst(Display.black, V.X, M.Y, V.W, V.Y - M.Y, 0)
  221.           END
  222.         END
  223.       END
  224.     END
  225.   END HandleFiller;
  226.  
  227.   PROCEDURE OpenDisplay* (UW, SW, H: INTEGER);
  228.     VAR Filler: Viewers.Viewer;
  229.   BEGIN
  230.      Input.SetMouseLimits(Viewers.curW + UW + SW, H);
  231.      Display.ReplConst(Display.black, Viewers.curW, 0, UW + SW, H, 0);
  232.      NEW(Filler); Filler.handle := HandleFiller;
  233.      Viewers.InitTrack(UW, H, Filler); (*init user track*)
  234.      NEW(Filler); Filler.handle := HandleFiller;
  235.      Viewers.InitTrack(SW, H, Filler) (*init system track*)
  236.   END OpenDisplay;
  237.  
  238.   PROCEDURE DisplayWidth* (X: INTEGER): INTEGER;
  239.   BEGIN RETURN DW
  240.   END DisplayWidth;
  241.  
  242.   PROCEDURE DisplayHeight* (X: INTEGER): INTEGER;
  243.   BEGIN RETURN DH
  244.   END DisplayHeight;
  245.  
  246.   PROCEDURE OpenTrack* (X, W: INTEGER);
  247.     VAR Filler: Viewers.Viewer;
  248.   BEGIN
  249.     NEW(Filler); Filler.handle := HandleFiller;
  250.     Viewers.OpenTrack(X, W, Filler)
  251.   END OpenTrack;
  252.  
  253.   PROCEDURE UserTrack* (X: INTEGER): INTEGER;
  254.   BEGIN RETURN X DIV DW * DW
  255.   END UserTrack;
  256.  
  257.   PROCEDURE SystemTrack* (X: INTEGER): INTEGER;
  258.   BEGIN RETURN X DIV DW * DW + DW DIV 8 * 5
  259.   END SystemTrack;
  260.  
  261.   PROCEDURE UY (X: INTEGER): INTEGER;
  262.     VAR fil, bot, alt, max: Display.Frame;
  263.   BEGIN
  264.     Viewers.Locate(X, 0, fil, bot, alt, max);
  265.     IF fil.H >= DH DIV 8 THEN RETURN DH END;
  266.     RETURN max.Y + max.H DIV 2
  267.   END UY;
  268.  
  269.   PROCEDURE AllocateUserViewer* (DX: INTEGER; VAR X, Y: INTEGER);
  270.   BEGIN
  271.     IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y
  272.     ELSE X := DX DIV DW * DW; Y := UY(X)
  273.     END
  274.   END AllocateUserViewer;
  275.  
  276.   PROCEDURE SY (X: INTEGER): INTEGER;
  277.     VAR fil, bot, alt, max: Display.Frame;
  278.   BEGIN
  279.     Viewers.Locate(X, DH, fil, bot, alt, max);
  280.     IF fil.H >= DH DIV 8 THEN RETURN DH END;
  281.     IF max.H >= DH - H0 THEN RETURN max.Y + H3 END;
  282.     IF max.H >= H3 - H0 THEN RETURN max.Y + H2 END;
  283.     IF max.H >= H2 - H0 THEN RETURN max.Y + H1 END;
  284.     IF max # bot THEN RETURN max.Y + max.H DIV 2 END;
  285.     IF bot.H >= H1 THEN RETURN bot.H DIV 2 END;
  286.     RETURN alt.Y + alt.H DIV 2
  287.   END SY;
  288.  
  289.   PROCEDURE AllocateSystemViewer* (DX: INTEGER; VAR X, Y: INTEGER);
  290.   BEGIN
  291.     IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y
  292.     ELSE X := DX DIV DW * DW + DW DIV 8 * 5; Y := SY(X)
  293.     END
  294.   END AllocateSystemViewer;
  295.  
  296.   PROCEDURE MarkedViewer* (): Viewers.Viewer;
  297.   BEGIN RETURN Viewers.This(Pointer.X, Pointer.Y)
  298.   END MarkedViewer;
  299.  
  300.   PROCEDURE PassFocus* (V: Viewers.Viewer);
  301.     VAR M: ControlMsg;
  302.   BEGIN M.id := defocus; FocusViewer.handle(FocusViewer, M); FocusViewer :=
  303. V
  304.   END PassFocus;
  305.  
  306.   (*command interpretation*)
  307.  
  308.   PROCEDURE Call* (name: ARRAY OF CHAR; par: ParList; new: BOOLEAN; VAR res:
  309. INTEGER);
  310.     VAR Mod: Modules.Module; P: Modules.Command; i, j: INTEGER;
  311.   BEGIN res := 1;
  312.     i := 0; j := 0;
  313.     WHILE name[j] # 0X DO
  314.       IF name[j] = "." THEN i := j END;
  315.       INC(j)
  316.     END;
  317.     IF i > 0 THEN
  318.       name[i] := 0X;
  319.       IF new THEN Modules.Free(name, FALSE) END;
  320.       Mod := Modules.ThisMod(name);
  321.       IF Modules.res = 0 THEN
  322.         INC(i); j := i;
  323.         WHILE name[j] # 0X DO name[j - i] := name[j]; INC(j) END;
  324.         name[j - i] := 0X;
  325.         P := Modules.ThisCommand(Mod, name);
  326.         IF Modules.res = 0 THEN
  327.           Par := par; Par.vwr := Viewers.This(par.frame.X, par.frame.Y); P;
  328. res := 0
  329.         ELSE res := -1
  330.         END
  331.       ELSE res := Modules.res
  332.       END
  333.     ELSE res := -1
  334.     END
  335.   END Call;
  336.  
  337.   PROCEDURE GetSelection* (VAR text: Texts.Text; VAR beg, end, time: LONGINT);
  338.     VAR M: SelectionMsg;
  339.   BEGIN
  340.     M.time := -1; Viewers.Broadcast(M); time := M.time;
  341.     IF time >= 0 THEN text := M.text; beg := M.beg; end := M.end END
  342.   END GetSelection;
  343.  
  344.   PROCEDURE* GC;
  345.   BEGIN IF ActCnt <= 0 THEN Kernel.GC; ActCnt := BasicCycle END
  346.   END GC;
  347.  
  348.   PROCEDURE Install* (T: Task);
  349.     VAR t: Task;
  350.   BEGIN t := PrevTask;
  351.     WHILE (t.next # PrevTask) & (t.next # T) DO t := t.next END;
  352.     IF t.next # T THEN T.next := PrevTask; t.next := T END
  353.   END Install;
  354.  
  355.   PROCEDURE Remove* (T: Task);
  356.     VAR t: Task;
  357.   BEGIN t := PrevTask;
  358.     WHILE (t.next # T) & (t.next # PrevTask) DO t := t.next END;
  359.     IF T = PrevTask THEN t.next := t.next.next; PrevTask := t
  360.     ELSIF t.next = T THEN t.next := T.next; PrevTask := t.next END;
  361.     IF CurTask = T THEN CurTask := PrevTask.next END
  362.   END Remove;
  363.  
  364.   PROCEDURE Collect* (count: INTEGER);
  365.   BEGIN ActCnt := count
  366.   END Collect;
  367.  
  368.   PROCEDURE SetFont* (fnt: Fonts.Font);
  369.   BEGIN CurFnt := fnt
  370.   END SetFont;
  371.  
  372.   PROCEDURE SetColor* (col: SHORTINT);
  373.   BEGIN CurCol := col
  374.   END SetColor;
  375.  
  376.   PROCEDURE SetOffset* (voff: SHORTINT);
  377.   BEGIN CurOff := voff
  378.   END SetOffset;
  379.  
  380.   PROCEDURE Loop*;
  381.     VAR V: Viewers.Viewer; M: InputMsg; N: ControlMsg;
  382.        prevX, prevY, X, Y: INTEGER; keys: SET; ch: CHAR;
  383.   BEGIN
  384.     LOOP
  385.       Input.Mouse(keys, X, Y);
  386.       IF Input.Available() > 0 THEN Input.Read(ch);
  387.         IF ch < 0F0X THEN
  388.           IF ch = ESC THEN
  389.             N.id := neutralize; Viewers.Broadcast(N); FadeCursor(Pointer)
  390.           ELSIF ch = SETUP THEN
  391.             N.id := mark; N.X := X; N.Y := Y; V := Viewers.This(X, Y); V.handle(V,
  392. N)
  393.           ELSE
  394.             IF ch < " " THEN
  395.               IF ch = 1X THEN ch := 83X (*ä*)
  396.               ELSIF ch = 0FX THEN ch := 84X (*ö*)
  397.               ELSIF ch = 15X THEN ch := 85X (*ü*)
  398.               END
  399.             ELSIF ch > "~" THEN
  400.               IF ch = 81X THEN ch := 80X (*Ä*)
  401.               ELSIF ch = 8FX THEN ch := 81X (*Ö*)
  402.               ELSIF ch = 95X THEN ch := 82X (*Ü*)
  403.               END
  404.             END;
  405.             M.id := consume; M.ch := ch; M.fnt := CurFnt; M.col := CurCol; M.voff
  406. := CurOff;
  407.             FocusViewer.handle(FocusViewer, M);
  408.             DEC(ActCnt)
  409.           END
  410.         ELSIF ch = 0F1X THEN Display.SetMode(0, {})   (*on*)
  411.         ELSIF ch = 0F2X THEN Display.SetMode(0, {0})  (*off*)
  412.         ELSIF ch = 0F3X THEN Display.SetMode(0, {2})  (*inv*)
  413.         ELSIF ch = 0F4X THEN Display.SetMode(0, {1})  (*alt*)
  414.         END
  415.       ELSIF keys # {} THEN
  416.         M.id := track; M.X := X; M.Y := Y; M.keys := keys;
  417.         REPEAT
  418.           V := Viewers.This(M.X, M.Y); V.handle(V, M);
  419.           Input.Mouse(M.keys, M.X, M.Y)
  420.         UNTIL M.keys = {};
  421.         DEC(ActCnt)
  422.       ELSE
  423.         IF (X # prevX) OR (Y # prevY) OR ~Mouse.on THEN
  424.           M.id := track; M.X := X; M.Y := Y; M.keys := keys; V := Viewers.This(X,
  425. Y); V.handle(V, M);
  426.           prevX := X; prevY := Y
  427.         END;
  428.         CurTask := PrevTask.next;
  429.         IF CurTask.time <= Input.Time() THEN
  430.           IF ~CurTask.safe THEN PrevTask.next := CurTask.next END;
  431.           CurTask.handle; PrevTask.next := CurTask
  432.         END;
  433.         PrevTask := CurTask
  434.       END
  435.     END
  436.   END Loop;
  437.  
  438. BEGIN User[0] := 0X;
  439.   Arrow.Fade := FlipArrow; Arrow.Draw := FlipArrow;
  440.   Star.Fade := FlipStar; Star.Draw := FlipStar;
  441.   OpenCursor(Mouse); OpenCursor(Pointer);
  442.  
  443.   DW := Display.Width; DH := Display.Height; CL := Display.ColLeft;
  444.   H3 := DH - DH DIV 3;
  445.   H2 := H3 - H3 DIV 2;
  446.   H1 := DH DIV 5;
  447.   H0 := DH DIV 10;
  448.  
  449.   unitW := DW DIV 8;
  450.   OpenDisplay(unitW * 5, unitW * 3, DH);
  451.   FocusViewer := Viewers.This(0, 0);
  452.  
  453.   CurFnt := Fonts.Default;
  454.   CurCol := Display.white;
  455.   CurOff := 0;
  456.  
  457.   Collect(BasicCycle);
  458.   NEW(PrevTask);
  459.   PrevTask.handle := GC;
  460.   PrevTask.safe := TRUE;
  461.   PrevTask.time := 0;
  462.   PrevTask.next := PrevTask;
  463.  
  464.   Display.SetMode(0, {});
  465.   Mod := Modules.ThisMod("System");
  466.  
  467. END Oberon.
  468.  
  469.